Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Pascal/Applications/NIH Image 1.60/1.60 Source/Stacks.p

Text File | 1996-03-08 | 57.4 KB | 2,142 lines | [TEXT/PJMM]

unit Stacks;

interface

    uses
        Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts,
        Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows,
        Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes,
        QDOffscreen, Timer, PictUtils,
        {Types, Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,
        Resources, Errors, Palettes, QDOffscreen, PictUtils, Timer, Windows, TextUtils,}
        globals, Utilities, Graphics, Analysis, Camera, file1, file2, filters, sound, lut;

    procedure MakeStack;
    procedure MakeWindowsFromStack;
    function AddSlice (update: boolean): boolean;
    procedure DeleteSlice;
    procedure ShowNextSlice (item: integer);
    procedure ShowFirstOrLastSlice (ich: integer);
    procedure DoStackInfo;
    procedure Reslice;
    procedure Animate;
    procedure MakeMovie(ShowDialog: boolean);
    procedure CaptureFrames;
    procedure MakeMontage;
    procedure ConvertRGBToEightBitColor (Capturing: boolean);
    procedure ConvertEightBitColorToRGB;
    procedure CaptureColor;
    procedure AverageSlices;
    procedure ConvertRGBToHSV;


implementation


    procedure MakeStack;
        var
            ok, isStack: boolean;
            i, result: integer;
            TempInfo, SaveInfo: InfoPtr;
            str: str255;
    begin
        if not AllSameSize then begin
                PutError('All currently open images must be the same size to make a stack.');
                exit(MakeStack);
            end;
        isStack := false;
        for i := 1 to nPics do begin
                TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
                isStack := isStack or (TempInfo^.StackInfo <> nil);
            end;
        if isStack then begin
                PutError('All stacks must be closed before making a new stack.');
                exit(MakeStack);
            end;
        if nPics > MaxSlices then begin
                NumToString(MaxSlices, str);
                PutError(concat('Maximun stack size is ', str, ' slices.'));
                exit(MakeStack);
            end;
        StopDigitizing;
        DisableDensitySlice;
        SelectWindow(PicWindow[1]);
        Info := pointer(WindowPeek(PicWindow[1])^.RefCon);
        ActivateWindow;
        KillRoi;
        UnZoom;
        if not MakeStackFromWindow then
            exit(MakeStack);
        with info^ do begin
                StackInfo^.nSlices := nPics;
                title := 'Stack';
                UpdateTitleBar;
                Revertable := false;
            end;
        SaveInfo := Info;
        MakingStack := true;
        ShowWatch;
        for i := 2 to nPics do begin
                TempInfo := pointer(WindowPeek(PicWindow[2])^.RefCon);
                with TempInfo^ do begin
                        hunlock(PicBaseHandle);
                        info^.StackInfo^.PicBaseH[i] := PicBaseHandle;
                    end;
                result := CloseAWindow(PicWindow[2]);
                Info := SaveInfo;
            end;
        UpdateWindowsMenuItem;
        MakingStack := false;
    end;


    procedure DeleteSlice;
        var
            SliceToDelete, NextSlice, i: integer;
            isRoi: boolean;
    begin
        with info^, info^.StackInfo^ do begin
                if nSlices = 1 then begin
                        WhatToUndo := NothingToUndo;
                        exit(DeleteSlice);
                    end;
                isRoi := RoiShowing;
                if isRoi then
                    KillRoi;
                SetupUndo;
                WhatToUndo := UndoSliceDelete;
                SliceToDelete := CurrentSlice;
                if CurrentSlice = 1 then begin
                        NextSlice := 2;
                        WhatToUndo := UndoFirstSliceDelete;
                    end
                else
                    NextSlice := CurrentSlice - 1;
                SelectSlice(NextSlice);
                UpdatePicWindow;
                DisposeHandle(PicBaseH[SliceToDelete]);
                for i := SliceToDelete to nSlices - 1 do
                    PicBaseH[i] := PicBaseH[i + 1];
                nSlices := nSlices - 1;
                if CurrentSlice <> 1 then
                    CurrentSlice := CurrentSlice - 1;
                if (StackType = rgbStack) and (nSlices <> 3) then
                    StackType := VolumeStack;
                UpdateTitleBar;
                if isRoi then
                    RestoreRoi;
                changes := true;
                UpdateWindowsMenuItem;
            end;
    end;


    procedure MakeWindowsFromStack;
        var
            i, ignore: integer;
            N: LongInt;
            SaveInfo: InfoPtr;
            tmp: longint;

        function MakeName (i: integer): str255;
            var
                str: str255;
        begin
            RealToString(i, 3, 0, str);
            if str[1] = ' ' then
                str[1] := '0';
            if str[2] = ' ' then
                str[2] := '0';
            MakeName := str;
        end;

    begin
        N := info^.StackInfo^.nSlices;
        tmp := SizeOf(PicInfo);
        if MaxBlock < (MinFree + info^.ImageSize + (SizeOf(PicInfo) + 2000) * N) then begin
                PutError('There is not enough memory available to convert this stack to windows.');
                exit(MakeWindowsFromStack);
            end;
        SaveInfo := Info;
        KillRoi;
        for i := 1 to N - 1 do begin
                SelectSlice(1);
                info^.StackInfo^.CurrentSlice := 1;
                if not Duplicate(MakeName(i), false) then
                    exit(MakeWindowsFromStack);
                info := SaveInfo;
                DeleteSlice;
            end;
        if Duplicate(MakeName(N), false) then begin
                info := SaveInfo;
                info^.changes := false;
                ignore := CloseAWindow(info^.wptr);
            end;
    end;


    procedure ShowNextSlice (item: integer);
        var
            isRoi: boolean;
    begin
        with info^, info^.StackInfo^ do begin
                if item = NextSliceItem then begin
                        CurrentSlice := CurrentSlice + 1;
                        if CurrentSlice > nSlices then
                            CurrentSlice := nSlices;
                    end
                else begin
                        CurrentSlice := CurrentSlice - 1;
                        if CurrentSlice < 1 then
                            CurrentSlice := 1;
                    end;
                isRoi := RoiShowing;
                if isRoi then
                    KillRoi;
                SelectSlice(CurrentSlice);
                UpdatePicWindow;
                UpdateTitleBar;
                WhatToUndo := NothingToUndo;
                isInsertionPoint:=false;
                if isRoi then
                    RestoreRoi;
            end;
    end;


    procedure ShowFirstOrLastSlice (ich: integer);
        var
            isRoi: boolean;
    begin
        with info^, info^.StackInfo^ do begin
                if ich = EndKey then
                    CurrentSlice := nSlices
                else
                    CurrentSlice := 1;
                isRoi := RoiShowing;
                if isRoi then
                    KillRoi;
                SelectSlice(CurrentSlice);
                UpdatePicWindow;
                UpdateTitleBar;
                WhatToUndo := NothingToUndo;
                isInsertionPoint:=false;
                if isRoi then
                    RestoreRoi;
            end;
    end;


    procedure GetSlice (xstart, ystart, start: extended; angle: extended; count: integer; var line: LineType);
        var
            i: integer;
            x, y, xinc, yinc: extended;
            IntegerStart: boolean;
    begin
        IntegerStart := (xstart = trunc(xstart)) and (ystart = trunc(ystart));
        if IntegerStart and (angle = 0.0) then begin
                GetLine(trunc(xstart), trunc(ystart), count, line);
                exit(GetSlice);
            end;
        if IntegerStart and (angle = 270.0) then begin
                GetColumn(trunc(xstart), trunc(ystart), count, line);
                exit(GetSlice);
            end;
        angle := (angle / 180.0) * pi;
        xinc := cos(angle);
        yinc := -sin(angle);
        x := xstart + start * xinc;
        y := ystart + start * yinc;
        for i := 0 to count - 1 do begin
                line[i] := round(GetInterpolatedPixel(x, y));
                x := x + xinc;
                y := y + yinc;
            end;
    end;


    function DoResliceOptions: boolean;
    var
        default, tmp: extended;
        Canceled: boolean;
        prompt, str: str255;
    begin
        with info^.StackInfo^, info^ do begin
            if SpatiallyCalibrated then begin
                default := SliceSpacing / xScale;
                str := xUnit;
            end else begin
                default := SliceSpacing;
                str := 'pixels';
            end;
            if SliceSpacing = 0.0 then
                default := 1.0;
            tmp := GetReal(concat('Slice Spacing (', str, '):'), default, 2, Canceled);
            if not Canceled and (tmp > 0.0) then begin
                    if SpatiallyCalibrated then
                        SliceSpacing := tmp * xScale
                    else
                        SliceSpacing := tmp;
                end;
        end; {with}
        DoResliceOptions := not canceled;
    end;


    procedure Reslice;
        var
            DstWidth, DstHeight, nSlices: integer;
            dstLeft, dstTop, y, i, j, LineLength: integer;
            SaveWindowFlag, SaveMacro, HorizontalMode: boolean;
            SaveHScale, SaveVScale, UncalibratedLineLength, CalibratedLineLength, angle: extended;
            Stack, Reconstruction: InfoPtr;
            aLine: LineType;
            name, str1, str2: str255;
            MaskRect: rect;
            x1, y1, x2, y2, ulength, clength: extended;

        procedure MakeRoi (Left, Top, Width, Height: integer);
        begin
            with info^ do begin
                    RoiType := RectRoi;
                    SetRect(RoiRect, left, top, left + width, top + height);
                    MakeRegion;
                    SetupUndo;
                    RoiShowing := true;
                end;
        end;

    begin
        with info^, info^.StackInfo^ do begin
                if nSlices < 2 then begin
                        PutError('Reslicing requires at least 2 slices.');
                        AbortMacro;
                        exit(Reslice);
                    end;
                if not (RoiShowing and (RoiType = LineRoi)) then begin
                        PutError('Please make a straight line selection first.');
                        AbortMacro;
                        exit(Reslice);
                    end;
                Stack := info;
                GetLengthOrPerimeter(ulength, clength);
                LineLength := round(ulength);
                if LineLength = 0 then begin
                        PutError('Line length cannot be zero.');
                        AbortMacro;
                        exit(Reslice);
                    end;
                if SliceSpacing = 0.0 then
                    if not DoResliceOptions then
                        exit(reslice);;
                GetLoi(x1, y1, x2, y2);
                if (LAngle = 0.0) or (LAngle = 270.0) then
                    if NotInBounds then
                        exit(Reslice);
                HorizontalMode := not OptionKeyWasDown;
                if HorizontalMode then begin
                        DstWidth := LineLength;
                        DstHeight := round(nSlices * SliceSpacing);
                        if DstHeight < nSlices then
                            DstHeight := nSlices;
                        dstLeft := 0;
                        dstTop := round((dstHeight - nSlices) / 2.0);
                    end
                else begin
                        DstWidth := round(nSlices * SliceSpacing);
                        if DstWidth < nSlices then
                            DstWidth := nSlices;
                        DstHeight := LineLength;
                        dstLeft := round((dstWidth - nSlices) / 2.0);
                        dstTop := 0;
                    end;
                RealToString(y1, 3, 0, str1);
                RealToString(LAngle, 1, 2, str2);
                name := concat(str1, '-', str2);
                if not NewPicWindow(name, DstWidth, DstHeight) then
                    exit(Reslice);
                Reconstruction := info;
                SaveWindowFlag := rsCreateNewWindow;
                SaveHScale := rsHScale;
                SaveVScale := rsVScale;
                rsCreateNewWindow := false;
                rsMethod := bilinear;
                for i := 1 to nSlices do begin
                        Info := Stack;
                        SelectSlice(i);
                        GetSlice(x1, y1, 0.0, LAngle, LineLength, aLine);
                        info := Reconstruction;
                        if HorizontalMode then begin
                                PutLine(dstLeft, dstTop + nSlices - i, LineLength, aLine);
                                if i = 1 then {Draw extra line needed to get scaling to work right.}
                                    PutLine(dstLeft, dstTop + nSlices, LineLength, aLine);
                                SetRect(MaskRect, dstLeft, dstTop + nSlices - i, dstLeft + LineLength, dstTop + nSlices - i + 1);
                            end
                        else begin
                                PutColumn(dstLeft + nSlices - i, dstTop, LineLength, aLine);
                                if i = 1 then {Draw extra line needed to get scaling to work right.}
                                    PutLine(dstLeft + nSlices, dstTop, LineLength, aLine);
                                SetRect(MaskRect, dstLeft + nSlices - i, dstTop, dstLeft + nSlices - i + 1, dstTop + LineLength);
                            end;
                        UpdateScreen(MaskRect);
                    end;
                if HorizontalMode then begin
                        MakeRoi(dstLeft, dstTop, LineLength, nSlices);
                        rsHScale := 1.0;
                        rsVScale := SliceSpacing;
                    end
                else begin
                        MakeRoi(dstLeft, dstTop, nSlices, LineLength);
                        rsHScale := SliceSpacing;
                        rsVScale := 1.0;
                    end;
                rsAngle := 0;
                SaveMacro := macro;
                macro := true;
                ScaleAndRotate;
                macro := SaveMacro;
                Info := Stack;
                SelectSlice(CurrentSlice);
                Info := Reconstruction;
                rsCreateNewWindow := SaveWindowFlag;
                rsHScale := SaveHScale;
                rsVScale := SaveVScale;
                KillRoi;
            end;
    end;


    procedure Animate;
        var
            n, SaveN, fpsInterval, DelayCount: integer;
            Event: EventRecord;
            ch: char;
            b: boolean;
            SingleStep, GoForward, NewKeyDown, PhotoMode: boolean;
            nFrames, StartTicks, NextTicks, SaveTicks, ticks: LongInt;
            fps, seconds: extended;

        procedure ShowFPS (fps: extended);
            var
                hstart, vstart, ivalue: integer;
                key: str255;
        begin
            if PhotoMode then
                exit(ShowFPS);
            hstart := InfoHStart;
            vstart := InfoVStart;
            SetPort(InfoWindow);
            MoveTo(xValueLoc, vstart);
            case DelayTicks of
                0:
                    key := '9 ';
                2:
                    key := '8 ';
                3:
                    key := '7 ';
                4:
                    key := '6 ';
                6:
                    key := '5 ';
                8:
                    key := '4 ';
                12:
                    key := '3 ';
                30:
                    key := '2 ';
                60:
                    key := '1 ';
            end;
            if SingleStep then begin
                    if GoForward then
                        key := '->'
                    else
                        key := '<-';
                end;
            DrawString(key);
            MoveTo(yValueLoc, vstart + 10);
            DrawReal(fps, 1, 2);
            DrawChar(' ');
        end;

    begin
        if info^.StackInfo = nil then begin
                PutError('Animation requires a stack.');
                exit(Animate);
            end;
        with info^, info^.StackInfo^ do begin
                if nSlices < 2 then begin
                        PutError('Animation requires at least two "slices".');
                        exit(Animate);
                    end;
                KillRoi;
                PhotoMode := OptionKeyDown or OptionKeyWasDown;
                if PhotoMode then
                    EraseScreen
                else begin
                        ShowWatch;
                        ShowMessage(concat('Use 1...9 keys to control speed', crStr, 'Use arrow keys to single step', crStr, 'Press mouse button to stop'));
                    end;
                FlushEvents(EveryEvent, 0);
                fpsInterval := 10;
                SaveN := -1;
                n := 1;
                GoForward := true;
                SingleStep := false;
                nFrames := 0;
                StartTicks := TickCount;
                NextTicks := StartTicks;
                SaveTicks := StartTicks;
                if not PhotoMode then begin
                        DrawLabels('key:', 'fps:', '');
                        SetPort(InfoWindow);
                        TextSize(9);
                        TextFont(Monaco);
                        TextMode(SrcCopy);
                    end;
                repeat
                    b := WaitNextEvent(EveryEvent, Event, 0, nil);
                    NewKeyDown := (event.what = KeyDown) or (event.what = AutoKey);
                    if NewKeyDown then begin
                            Ch := chr(BitAnd(Event.message, 127));
                            SingleStep := false;
                            case ord(ch) of
                                28, 44, 60, PageUp: {<-, <}
                                    begin
                                        SingleStep := true;
                                        GoForward := false;
                                        n := n - 1;
                                        if n < 1 then
                                            n := 1;
                                        DelayTicks := 0
                                    end; {left}
                                29, 46, 62, PageDown:  {->, >}
                                    begin
                                        SingleStep := true;
                                        GoForward := true;
                                        n := n + 1;
                                        if n > nSlices then
                                            n := nSlices;
                                        DelayTicks := 0
                                    end;  {right}
                                57:
                                    DelayTicks := 0;  {'9'-max speed}
                                56:
                                    DelayTicks := 2;  {'8'-30 fps}
                                55:
                                    DelayTicks := 3;  {'7'-20 fps}
                                54:
                                    DelayTicks := 4;  {'6'-15 fps}
                                53:
                                    DelayTicks := 6;  {'5'-10 fps}
                                52:
                                    DelayTicks := 8; {'4'-7.5 fps}
                                51:
                                    DelayTicks := 12; {'3'-5 fps}
                                50:
                                    DelayTicks := 30; {'2'-2 fps}
                                49:
                                    DelayTicks := 60; {'1'-1 fps}
                                otherwise
                            end; {case}
                            if DelayTicks > 12 then
                                fpsInterval := 2
                            else if DelayTicks > 3 then
                                fpsInterval := 5
                            else
                                fpsInterval := 10;
                        end; {if NewKeyDown}
                    if GoForward then begin
                            if not SingleStep then
                                n := n + 1;
                            if n > nSlices then begin
                                    if OscillatingMovies then begin
                                            n := nSlices - 1;
                                            GoForward := false;
                                        end
                                    else
                                        n := 1;
                                end;
                        end
                    else begin
                            if not SingleStep then
                                n := n - 1;
                            if n < 1 then begin
                                    if OscillatingMovies then begin
                                            n := 2;
                                            Goforward := true;
                                        end
                                    else
                                        n := nSlices;
                                end;
                        end;
                    CurrentSlice := n;
                    SelectSlice(CurrentSlice);
                    UpdatePicWindow;
                    nFrames := nFrames + 1;
                    if SingleStep then begin
                            if (not OptionKeyWasDown) and (n <> SaveN) then begin
                                    UpdateTitleBar;
                                    SaveN := n;
                                end;
                            ShowFPS(0.0);
                        end
                    else if (nFrames mod fpsInterval) = 0 then begin
                            ticks := TickCount;
                            seconds := (ticks - SaveTicks) / 60.0;
                            if seconds <> 0.0 then
                                fps := fpsInterval / seconds
                            else
                                fps := 0.0;
                            ShowFPS(fps);
                            SaveTicks := ticks;
                        end;
                    DelayCount := 0;
                    if DelayTicks > 0 then begin
                            repeat
                                ticks := TickCount;
                            until ticks >= NextTicks;
                            NextTicks := ticks + DelayTicks;
                        end;
                until (event.what = MouseDown) or (event.what = osEvt);
                if PhotoMode then
                    RestoreScreen;
                FlushEvents(EveryEvent, 0);
                UpdateTitleBar
            end; {with}
    end;


    function Activate (name: str255): boolean;
  {Activates the window with the specified name.}
        var
            i: integer;
            TempInfo: InfoPtr;
    begin
        Activate := false;
        for i := 1 to nPics do begin
                TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
                if TempInfo^.title = name then begin
                        if PicWindow[i] <> nil then begin
                                SelectWindow(PicWindow[i]);
                                Info := TempInfo;
                                ActivateWindow;
                                Activate := true;
                            end; {if}
                        leave;
                    end; {if}
            end; {for}
    end;


    function DoMakeMovieOptions: boolean;
    const
        FramesID = 3;
        IntervalID = 5;
        rateID = 7;
        BlindID = 9;
        LG3BufferID = 10;
        StampID = 11;
        UseExistingStackID = 12;
        TriggerID = 13;
        TriggerFirstID = 14;
        TriggerEachID = 15;
    var
        mylog: DialogPtr;
        item, i: integer;
        FramesPerSecond: extended;

        procedure ShowFrameRate;
        begin
            if SecondsPerFrame = 0.0 then begin
                if fgWidth = 640 then
                    FramesPerSecond := 30.0
                else FramesPerSecond := 25.0
            end else
                FramesPerSecond := 1.0 / SecondsPerFrame;
            if FramesPerSecond = trunc(FramesPerSecond) then
                SetDReal(MyLog, rateID, FramesPerSecond, 0)
            else
                SetDReal(MyLog, rateID, FramesPerSecond, 4);
        end;

        procedure ShowInterval;
        begin
            if SecondsPerFrame < 1.0 then
                SetDReal(MyLog, IntervalID, SecondsPerFrame, 4)
            else if SecondsPerFrame < 99.0 then
                SetDReal(MyLog, IntervalID, SecondsPerFrame, 2)
            else
                SetDReal(MyLog, IntervalID, SecondsPerFrame, 0);
        end;

        procedure ShowTriggerMode;
        begin
            SetDlogItem(mylog, TriggerID, ord(ExternalTrigger));
            SetDlogItem(mylog, TriggerFirstID, ord(TriggerFirstFrameOnly));
            SetDlogItem(mylog, TriggerEachID, ord(not TriggerFirstFrameOnly));
        end;

    begin
        InitCursor;
        mylog := GetNewDialog(230, nil, pointer(-1));
        SetDNum(MyLog, FramesID, FramesWanted);
        ShowFrameRate;
        ShowInterval;
        SetDlogItem(mylog, BlindID, ord(BlindMovieCapture));
        SetDlogItem(mylog, LG3BufferID, ord(LG3BufferCapture));
        SetDlogItem(mylog, StampID, ord(TimeStamp));
        ShowTriggerMode;
        SetDlogItem(mylog, UseExistingStackID, ord(UseExistingStack));
        SelectDialogItemText(MyLog, FramesID, 0, 32767);
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if item = FramesID then
                FramesWanted := GetDNum(MyLog, FramesID);
            if item = IntervalID then begin
                SecondsPerFrame := GetDReal(MyLog, IntervalID);
                ShowFrameRate;
            end;
            if item = rateID then begin
                FramesPerSecond := GetDReal(MyLog, rateID);
                if FramesPerSecond <> 0.0 then
                  SecondsPerFrame := 1.0 / FramesPerSecond;
                ShowInterval;
            end;
            if item = BlindID then begin
                    BlindMovieCapture := not BlindMovieCapture;
                    SetDlogItem(mylog, BlindID, ord(BlindMovieCapture));
                end;
            if item = LG3BufferID then begin
                    LG3BufferCapture := not LG3BufferCapture;
                    if LG3BufferCapture then
                        BlindMovieCapture := true;
                    SetDlogItem(mylog, LG3BufferID, ord(LG3BufferCapture));
                    SetDlogItem(mylog, BlindID, ord(BlindMovieCapture));
                end;
            if item = StampID then begin
                    TimeStamp := not TimeStamp;
                    SetDlogItem(mylog, StampID, ord(TimeStamp));
                end;
            if item = TriggerID then begin
                ExternalTrigger := not ExternalTrigger;
                SetDlogItem (mylog, TriggerID, ord (ExternalTrigger));
              end;
            if (item = TriggerFirstID) or (item = TriggerEachID) then begin
                TriggerFirstFrameOnly := not TriggerFirstFrameOnly;
                ExternalTrigger := true;
                ShowTriggerMode;
              end;
            if item = UseExistingStackID then begin
                    UseExistingStack := not UseExistingStack;
                    SetDlogItem(mylog, UseExistingStackID, ord(UseExistingStack));
                end;
        until (item = ok) or (item = cancel);
        DisposeDialog(mylog);
        if FramesWanted < 1 then
            FramesWanted := 1;
        if FramesWanted > MaxSlices then
            FramesWanted := MaxSlices;
        if SecondsPerFrame < 0.0 then
            SecondsPerFrame := 0.0;
        if LG3BufferCapture and (item <> cancel) then begin
            if FrameGrabber <> ScionLG3 then begin
                LG3BufferCapture := false;
                PutError('Capturing to an on-board frame buffer requires a Scion LG-3.');
                DoMakeMovieOptions := false;
                exit(DoMakeMovieOptions);
            end;
            if PCIFrameGrabber then begin
                LG3BufferCapture := false;
                PutError('On-board capture not supported on PCI frame grabbers.');
                DoMakeMovieOptions := false;
                exit(DoMakeMovieOptions);
            end;
            if FramesWanted > MaxLG3Frames then begin
                FramesWanted := MaxLG3Frames;
                PutError(concat('This ', long2str(MaxLG3Frames div 2), 'MB LG-3 can capture a maximum of ', long2str(MaxLG3Frames), ' frames to its on-board buffer.'));
                DoMakeMovieOptions := false;
                exit(DoMakeMovieOptions);
            end;
        end;
        DoMakeMovieOptions := item <> cancel;
    end;


    procedure CaptureFramesUsingTicks(SecondsPerFrame:extended; nFrames:integer; frect:rect);
    var
        StartTicks, NextTicks, LastTicks, interval, ticks: LongInt;
        SourcePixMap: PixMapHandle;
        str: str255;
        frame, i: integer;
        ElapsedTime, avgFrameInterval: extended;
    begin
        interval := round(60.0 * SecondsPerFrame);
        ShowWatch;
        SourcePixMap := fgPixMap;
        ResetFrameGrabber;
        ShowTriggerMessage;
        with info^, info^.StackInfo^ do begin
                if Interval >= 30 then
                    ShowMessage(CmdPeriodToStop)
                else
                    DrawLabels('Frame:', 'Total:', '');
                if TimeStamp then begin
                    SetPort(GrafPtr(osPort));
                    TextFont(Monaco);
                    TextSize(9);
                end;
                for frame := 1 to nFrames do begin
                        CurrentSlice := frame;
                        SelectSlice(CurrentSlice);
                        if Interval >= 30 then
                            UpdateTitleBar
                        else
                            Show2Values(CurrentSlice, nSlices);
                        GetFrame;
                        ticks:=TickCount;
                        if (frame = 1) then begin
                            StartTicks := ticks;
                            NextTicks := StartTicks+interval - 3;
                            if TriggerFirstFrameOnly then
                                ExternalTrigger := false;
                        end else
                            NextTicks := NextTicks + interval;
                        if frame = nFrames then
                            LastTicks := ticks;
                        CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                        if TimeStamp then begin
                            ElapsedTime:=(ticks-StartTicks) / 60.0;
                            RealToString(ElapsedTime, 9, 3, str);
                            for i:=1 to 5 do
                                if str[i]=' ' then str[i]:='0';
                            MoveTo(2,10);
                            DrawString(str);
                            PlotData^[frame]:=ElapsedTime;
                        end;
                        if not BlindMovieCapture then
                            UpdatePicWindow;
                        while TickCount < NextTicks do
                            if CommandPeriod then begin
                                    beep;
                                    wait(60);
                                    exit(CaptureFramesUsingTicks);
                                end;
                    end; {for}
                ElapsedTime := (LastTicks - StartTicks) / 60.0;
                avgFrameInterval := ElapsedTime / (nFrames - 1);
                FrameInterval := avgFrameInterval;
            end; {with}
    end;



    procedure DrawTimeStamps(nFrames: integer);
    var
        frame, i: integer;
        str: str255;
        SaveGDevice: GDHandle;
    begin
        with info^, info^.StackInfo^ do begin
            SaveGDevice := GetGDevice;
            SetGDevice(osGDevice);
            SetPort(GrafPtr(osPort));
            TextFont(Monaco);
            TextSize(9);
            for frame := 1 to nFrames do begin
                ShowAnimatedWatch;
                CurrentSlice := frame;
                SelectSlice(CurrentSlice);
                RealToString(PlotData^[frame], 9, 3, str);
                for i:=1 to 5 do
                    if str[i]=' ' then str[i]:='0';
                MoveTo(2,10);
                DrawString(str);
            end; {for}
            SetGDevice(SaveGDevice);
        end;
    end;


    function uTickCount:extended;
    var
        count:UnsignedWide;
        d:extended;
    begin
        microseconds(count);
        d:=count.lo;
        if d<0 then d:=band(count.lo,$7fffffff)+2147483648.0;
        uTickCount:=d+count.hi*4294967296.0;
    end;


    procedure CaptureFramesUsingMicroTicks(SecondsPerFrame:extended; nFrames:integer; frect:rect);
    var
        uStartTicks, uNextTicks, uLastTicks, uInterval, uTicks: Extended;
        SourcePixMap: PixMapHandle;
        frame, i: integer;
        ElapsedTime: extended;
        uTicksToCaptureOneFrame, avgFrameInterval:extended;
        ShowProgress: boolean;
    begin
        ShowWatch;
        uInterval := 1000000.0 * SecondsPerFrame;
        SourcePixMap := fgPixMap;
        ResetFrameGrabber;
        if PCIFrameGrabber then begin
            DoubleBuffering := true;
            LG3BufferCapture := false;
            CurrentBufferIsZero := true;
        end;
        ShowTriggerMessage;
        if fgWidth = 768 then  {if PAL board}
            uTicksToCaptureOneFrame := 40000.0  {PAL captures 25 fps}
        else
            uTicksToCaptureOneFrame := 33333.0;  {non-PAL captures 33 fps}
        ShowProgress := ((not LG3BufferCapture) and (not DoubleBuffering)) or (uInterval > (2 * uTicksToCaptureOneFrame));
        with info^, info^.StackInfo^ do begin
                if ShowProgress and (uInterval < 500000.0) then
                    DrawLabels('Frame:', 'Total:', '')
                else if not ExternalTrigger then
                    ShowMessage(CmdPeriodToStop);
                for frame := 1 to nFrames do begin
                    CurrentSlice := frame;
                    if DoubleBuffering and (frame > 1) then {??}
                        SelectSlice(CurrentSlice - 1)
                    else
                        SelectSlice(CurrentSlice);
                    if showProgress then begin
                        if uInterval >= 500000.0 then
                            UpdateTitleBar
                        else
                            Show2Values(CurrentSlice, nSlices);
                    end;
                    if DoubleBuffering then begin
                        StartFrame;
                        if frame <> 1 then
                            CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                        StopFrame;
                        uTicks := uTickCount;
                    end else if LG3BufferCapture then begin
                        BufferReg^ := frame - 1;
                        GetFrame;
                        uTicks := uTickCount;
                    end else begin
                        GetFrame;
                        uTicks := uTickCount;
                        CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                    end;
                    if frame = 1 then begin
                        uStartTicks := uTicks;
                        uNextTicks := uStartTicks + uInterval - 1.5 * uTicksToCaptureOneFrame;
                        if TriggerFirstFrameOnly then
                            ExternalTrigger := false;
                    end else
                        uNextTicks :=uNextTicks + uInterval;
                    if frame = nFrames then
                        uLastTicks := uTicks;
                    if TimeStamp then begin
                        ElapsedTime:=(uTicks-uStartTicks) / 1000000.0;
                        PlotData^[frame]:=ElapsedTime;
                    end;
                    if not BlindMovieCapture then
                        UpdatePicWindow;
                    if uTicks < uNextTicks then
                        while uTickCount < uNextTicks do
                            if CommandPeriod then begin
                                    beep;
                                    wait(60);
                                    exit(CaptureFramesUsingMicroTicks);
                                end;
                    end; {for}
                ElapsedTime := (uLastTicks - uStartTicks) / 1000000.0;
                avgFrameInterval := ElapsedTime / (nFrames - 1);
                FrameInterval := avgFrameInterval;
            end; {with}
        if LG3BufferCapture then begin
            {Copy captured frames from LG-3 to stack.}
            with info^, info^.StackInfo^ do begin
                for frame := 1 to nFrames do begin
                    ShowAnimatedWatch;
                    CurrentSlice := frame;
                    SelectSlice(CurrentSlice);
                    BufferReg^ := frame - 1;
                    CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                end; {for}
            end; {with}
            BufferReg^ := 0;
        end; {if LG3BufferCapture}
        if DoubleBuffering then with info^, info^.StackInfo^ do begin
            CurrentSlice := nframes;
            SelectSlice(CurrentSlice);
            CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
            BufferReg^ := 0;
            CurrentBufferIsZero := true;
            DoubleBuffering := false;
            with fgPort^.PortPixMap^^ do
                BaseAddr := ptr(fgSuperSlotBase0);
        end;
        if TimeStamp then
            DrawTimeStamps(nFrames);
    end;



    procedure MakeMovie(ShowDialog: boolean);
        var
            nFrames, wleft, wtop, width, height: integer;
            ignore, SaveFW: integer;
            OutOfMemory: boolean;
            seconds: extended;
            frect: rect;
            Canceled: boolean;
            avgFrameInterval: extended;
    begin
        SelectCameraWindow;
        with info^ do begin
            if PictureType <> FrameGrabberType then begin
                    PutError('You must be capturing to make a movie.');
                    exit(MakeMovie);
                end;
            StopDigitizing;
            if not (RoiShowing and (RoiType = RectRoi)) then begin
                    PutError('Please make a rectangular selection first.');
                    exit(MakeMovie);
                end;
            if NotInBounds then
                exit(MakeMovie);
            if ShowDialog then
                if not DoMakeMovieOptions then begin
                    AbortMacro;
                    exit(MakeMovie);
                end;
            if (FrameGrabber <> ScionLG3) then
                LG3BufferCapture := false;
            if LG3BufferCapture and (FramesWanted > MaxLG3Frames) then
                FramesWanted := MaxLG3Frames;
            if LG3BufferCapture then
                BlindMovieCapture := true;
            with RoiRect do begin
                    left := band(left + 1, $fffc);   {Word align}
                    right := band(right + 2, $fffc);
                    if right > PicRect.right then
                        right := PicRect.right;
                    MakeRegion;
                    wleft := left;
                    wtop := top;
                    width := right - left;
                    height := bottom - top;
                end;
            end; {with info^}
        with frect do begin
                left := wleft;
                top := wtop;
                right := left + width;
                bottom := top + height;
            end;
        if UseExistingStack then begin
            if not Activate('Movie') then begin
                PutError('Can''t find a stack named "Movie".');
                UseExistingStack := false;
                AbortMacro;
                exit(MakeMovie);
            end;
            with info^ do begin
                if (PixelsPerLine <> width) or (nLines <> height) then begin
                    PutError('The dimensions of the stack "Movie" are not the same as the selection.');
                    exit(MakeMovie);
                end;
                nFrames := StackInfo^.nSlices;
                if nFrames > FramesWanted then
                    nFrames := FramesWanted;
            end {with info}
        end else begin
            if not NewPicWindow('Movie', width, height) then
                exit(MakeMovie);
            if not MakeStackFromWindow then
                exit(MakeMovie);
            nFrames := 1;
            OutOfMemory := false;
            while (nFrames < FramesWanted) and (not OutOfMemory) do begin
                    OutOfMemory := not AddSlice(false);
                    if not OutOfMemory then
                        nFrames := nFrames + 1;
                end;
        end;
        if ExternalTrigger and not TriggerFirstFrameOnly then
            SecondsPerFrame := 0.0;
        If (FramesWanted < 1) then
            FramesWanted := 1;
        if SecondsPerFrame < 0.0 then
            SecondsPerFrame := 0.0;
        with info^.StackInfo^ do begin
            FrameInterval := 0.0;
            StackType := movieStack;
        end;
        if OptionKeyWasDown then
            CaptureFramesUsingTicks(SecondsPerFrame, nFrames, frect)
        else
            CaptureFramesUsingMicroTicks(SecondsPerFrame, nFrames, frect);
        ShowFirstOrLastSlice(HomeKey);
        avgFrameInterval := info^.StackInfo^.FrameInterval;
        if AvgFrameInterval <> 0.0 then
            ShowMessage(StringOf(nFrames:1, ' frames', cr,
                AvgFrameInterval * nFrames:1:2, ' seconds', cr,
                AvgFrameInterval:1:3, ' seconds/frame', cr,
                1 / AvgFrameInterval:1:2, ' frames/second'));
        if TimeStamp then begin
            PlotData^[0] := nFrames;
            PlotData^[nFrames + 1] := SecondsPerFrame;
            PlotCount := 0;
        end;
    end;


    procedure CaptureFrames;
        var
            nFrames, wleft, wtop, width, height, i: integer;
            ignore, SaveFW: integer;
            OutOfMemory, AdvanceFrame, b: boolean;
            frect: rect;
            MainDevice: GDHandle;
            SourcePixMap: PixMapHandle;
            Event: EventRecord;
            ShutterSound: SndListHandle;
            err: OSErr;

        procedure CheckButton;
        begin
            if Button and not AdvanceFrame then
                with Info^.StackInfo^ do begin
                        AdvanceFrame := true;
                        ShutterSound := SndListHandle(GetResource('snd ', 100));
                        if ShutterSound <> nil then
                            err := SndPlay(nil, ShutterSound, false);
                        if CurrentSlice < nSlices then begin
                                CurrentSlice := CurrentSlice + 1;
                                UpdateTitleBar;
                                CurrentSlice := CurrentSlice - 1;
                            end;
                    end;
        end;

    begin
        with info^ do begin
                if PictureType <> FrameGrabberType then begin
                        PutError('You must be capturing to capture frames.');
                        exit(CaptureFrames);
                    end;
                StopDigitizing;
                if not (RoiShowing and (RoiType = RectRoi)) then begin
                        PutError('Please make a rectangular selection first.');
                        exit(CaptureFrames);
                    end;
                if NotInBounds then
                    exit(CaptureFrames);
                SaveFW := FramesWanted;
                ShutterSound := nil;
                with RoiRect do begin
                        left := band(left + 1, $fffc);   {Word align}
                        right := band(right + 2, $fffc);
                        if right > PicRect.right then
                            right := PicRect.right;
                        MakeRegion;
                        wleft := left;
                        wtop := top;
                        width := right - left;
                        height := bottom - top;
                    end;
            end; {with info^}
        with frect do begin
                left := wleft;
                top := wtop;
                right := left + width;
                bottom := top + height;
            end;
        if not NewPicWindow('Frames', width, height) then
            exit(CaptureFrames);
        if not MakeStackFromWindow then
            exit(CaptureFrames);
        UpdateTitleBar;
        ShowWatch;
        SourcePixMap := fgPixMap;
        ResetFrameGrabber;
        FlushEvents(EveryEvent, 0);
        ExternalTrigger := false;
        UpdateVideoControl;
        with info^, info^.StackInfo^ do begin
                ShowMessage(CmdPeriodToStop);
                OutOfMemory := false;
                AdvanceFrame := false;
                while (not OutOfMemory) and (CurrentSlice <= MaxSlices) do begin
                        if AdvanceFrame then begin
                                OutOfMemory := not AddSlice(false);
                                AdvanceFrame := false;
                            end;
                        GetFrame;
                        CheckButton;
                        CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                        CheckButton;
                        UpdatePicWindow;
                        CheckButton;
                        b := WaitNextEvent(EveryEvent, Event, 0, nil);
                        if event.what = KeyDown then
                            leave;
                    end; {while}
            end; {with}
        if ShutterSound <> nil then
            ReleaseResource(handle(ShutterSound));
    end;



    procedure CopyPics (sPort, dPort: cGrafPtr; sRect, dRect: rect);
    begin
        pmForeColor(BlackIndex);
        pmBackColor(WhiteIndex);
        CopyBits(BitMapHandle(sPort^.portPixMap)^^, BitMapHandle(dPort^.PortPixMap)^^, sRect, dRect, SrcCopy, nil);
        pmForeColor(ForegroundIndex);
        pmBackColor(BackgroundIndex);
    end;


    procedure MakeMontage;
  {Opens a new window and creates a composite image}
  {from the slices in the current stack.}
    const
        ColumnsID = 3;
        RowsID = 4;
        ScaleID = 5;
        FirstID = 6;
        LastID = 7;
        IncrementID = 8;
        NumberID = 9;
        BordersID=16;
    var
        mylog: DialogPtr;
        item, i, nRows, nColumns, Inc, slices: integer;
        StackWidth, StackHeight, mWidth, mHeight, Background: integer;
        dWidth, dHeight, dLeft, dTop, dRight, dBottom, MaxWidth, MaxHeight: integer;
        FirstSlice, LastSlice, TotalSlices: integer;
        scale, SaveScale: extended;
        sPort, dPort: cGrafPtr;
        StackInfo, MontageInfo: InfoPtr;
        sRect, dRect: rect;
        IncrementSet: boolean;
        str: str255;
        loc: point;
        SaveGDevice: GDHandle;

    procedure Estimate (var scale:extended{ppc-bug}; adjustinc: boolean);
        var
            tmp, xxScale, yyScale: extended;
            n: integer;
    begin
        slices := LastSlice - FirstSlice + 1;
        if adjustinc then
            inc := 0;
        repeat
            if adjustinc then
                inc := inc + 1;
            n := trunc(slices / inc);
            tmp := sqrt(n);
            if trunc(tmp) <> tmp then
                tmp := trunc(tmp) + 1.0;
            nColumns := trunc(tmp);
            nRows := nColumns;
            if (nColumns * (nRows - 1)) >= n then
                nRows := nRows - 1;
            xxScale := (MaxWidth / nColumns) / StackWidth;
            yyScale := (MaxHeight / nRows) / StackHeight;
            if xxScale < yyScale then
                scale := xxScale
            else
                scale := yyScale;
            if scale > 1.0 then
                scale := 1.0;
            SaveScale := scale;
        until (scale >= 0.5) or (inc >= 3) or not adjustinc;
    end;

    begin
        InitCursor;
        with info^ do begin
                StackWidth := PixelsPerLine;
                StackHeight := nLines;
                FirstSlice := 1;
                TotalSlices := StackInfo^.nSlices;
                LastSlice := TotalSlices;
            end;
        MaxWidth := ScreenWidth - 85;
        MaxHeight := ScreenHeight - 45;
        Estimate(scale, true);
        IncrementSet := false;
        mylog := GetNewDialog(150, nil, pointer(-1));
        SetDNum(MyLog, RowsID, nRows);
        SetDNum(MyLog, ColumnsID, nColumns);
        SetDReal(MyLog, ScaleID, scale, 2);
        SetDNum(MyLog, FirstID, FirstSlice);
        SetDNum(MyLog, LastID, LastSlice);
        SetDNum(MyLog, IncrementID, inc);
        SetDlogItem(MyLog, NumberID, ord(gNumberSlices));
        SetDlogItem(MyLog, BordersID, ord(gBorders));
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if item = ColumnsID then begin
                    nColumns := GetDNum(MyLog, ColumnsID);
                    if nColumns < 0 then begin
                            nColumns := 0;
                            SetDNum(MyLog, ColumnsID, nRows);
                        end;
                end;
            if item = RowsID then begin
                    nRows := GetDNum(MyLog, RowsID);
                    if nRows < 0 then begin
                            nRows := 0;
                            SetDNum(MyLog, RowsID, nRows);
                        end;
                end;
            if item = ScaleID then
                scale := GetDReal(MyLog, ScaleID);
            if item = FirstID then begin
                    FirstSlice := GetDNum(MyLog, FirstID);
                    if (FirstSlice < 1) or (FirstSlice > LastSlice) then
                        FirstSlice := 1;
                    if IncrementSet then
                        Estimate(scale, false)
                    else
                        Estimate(scale, true);
                    SetDNum(MyLog, RowsID, nRows);
                    SetDNum(MyLog, ColumnsID, nColumns);
                    SetDReal(MyLog, ScaleID, scale, 2);
                end;
            if item = LastID then begin
                    LastSlice := GetDNum(MyLog, LastID);
                    if (LastSlice < FirstSlice) or (LastSlice > TotalSlices) then
                        LastSlice := TotalSlices;
                    if IncrementSet then
                        Estimate(scale, false)
                    else
                        Estimate(scale, true);
                    SetDNum(MyLog, RowsID, nRows);
                    SetDNum(MyLog, ColumnsID, nColumns);
                    SetDReal(MyLog, ScaleID, scale, 2);
                end;
            if item = IncrementID then begin
                    inc := GetDNum(MyLog, IncrementID);
                    IncrementSet := true;
                    if (inc < 1) or (inc > (slices div 2)) then begin
                            inc := 1;
                            SetDNum(MyLog, IncrementID, inc);
                        end;
                    Estimate(scale, false);
                    SetDNum(MyLog, RowsID, nRows);
                    SetDNum(MyLog, ColumnsID, nColumns);
                    SetDReal(MyLog, ScaleID, scale, 2);
                end;
            if item = NumberID then begin
                    gNumberSlices := not gNumberSlices;
                    SetDlogItem(MyLog, NumberID, ord(gNumberSlices));
                end;
            if item = BordersID then begin
                    gBorders := not gBorders;
                    SetDlogItem(MyLog, BordersID, ord(gBorders));
                end;
        until (item = ok) or (item = cancel);
        DisposeDialog(mylog);
        if item = cancel then
            exit(MakeMontage);
        if (scale <= 0.05) or (scale > 5) then
            scale := SaveScale;
        dWidth := round(StackWidth * scale);
        dHeight := round(StackHeight * scale);
        mWidth := nColumns * dWidth;
        mHeight := nRows * dHeight;
        StackInfo := info;
        Background := MyGetPixel(0, 0);
        SetBackgroundColor(Background);
        if Background = WhiteIndex then
            SetForegroundColor(BlackIndex)
        else
            SetForegroundColor(WhiteIndex);
        if not NewPicWindow('Montage', mWidth, mHeight) then
            exit(MakeMontage);
        MontageInfo := info;
        SaveGDevice := GetGDevice;
        SetGDevice(osGDevice);
        SetPort(GrafPtr(info^.osPort));
        pmForeColor(ForegroundIndex);
        dPort := info^.osPort;
        dLeft := 0;
        dTop := 0;
        sPort := StackInfo^.osPort;
        sRect := StackInfo^.PicRect;
        i := FirstSlice;
        while i <= LastSlice do begin
                Info := StackInfo;
                SelectSlice(i);
                SetRect(dRect, dLeft, dTop, dLeft + dWidth, dTop + DHeight);
                CopyPics(sPort, dPort, sRect, dRect);
                info := MontageInfo;
                if gNumberSlices then begin
                        MoveTo(dLeft + (dWidth div 2) - 3, dTop + dHeight - 9);
                        NumToString(i, str);
                        loc.h := dLeft + (dWidth div 2) - 3;
                        loc.v := dTop + dHeight - 5;
                        DrawTextString(str, loc, TeJustCenter);
                    end;
                if gBorders then with dRect do begin
                    PenSize(LineWidth, LineWidth);
                    MoveTo(left,bottom);
                    LineTo(left,top);
                    LineTo(right,top);
                    LineTo(right,bottom);
                    LineTo(left,bottom);
                end;
                UpdateScreen(dRect);
                dLeft := dLeft + dWidth;
                if (dLeft + dWidth) > mWidth then begin
                        dLeft := 0;
                        dTop := dTop + dHeight;
                    end;
                i := i + inc;
            end;
        if gBorders then
            FrameRect(info^.PicRect);
        SetGDevice(SaveGDevice);
        info := StackInfo;
        SelectSlice(info^.StackInfo^.CurrentSlice);
        info := MontageInfo;
        if info^.PixMapSize > UndoBufSize then
            PutWarning;
    end;


    procedure CopyRGBToPixMap (pmap: PixMapHandle);
        type
            LongPtr = ^LongInt;
        var
            row, i, width, WatchRate: integer;
            RedLine, GreenLine, BlueLine: LineType;
            Pixel, RowOffset: LongInt;
            pmapPtr: ptr;
            LPtr, RowStart: LongPtr;
    begin
        with info^ do begin
                pmapPtr := GetPixBaseAddr(pmap);
                if pmapPtr = nil then
                    exit(CopyRGBToPixMap);
                LPtr := LongPtr(pmapPtr);
                RowStart := LPtr;
                RowOffset := band(pmap^^.RowBytes, $3FFF);
                width := PicRect.right;
                WatchRate := 40000 div PixelsPerLine;
                for row := 0 to nLines - 1 do begin
                        if (row mod WatchRate) = 0 then
                            ShowAnimatedWatch;
                        SelectSlice(1);
                        GetLine(0, row, width, RedLine);
                        SelectSlice(2);
                        GetLine(0, row, width, GreenLine);
                        SelectSlice(3);
                        GetLine(0, row, width, BlueLine);
                        LPtr := RowStart;
                        for i := 0 to PixelsPerLine - 1 do begin
                                pixel := -1;
                                pixel := RedLine[i];
                                pixel := bor(bsl(pixel, 8), GreenLine[i]);
                                pixel := bor(bsl(pixel, 8), blueLine[i]);
                                LPtr^ := BitNot(pixel);
                                LPtr := LongPtr(ord4(LPtr) + 4);
                            end;
                        RowStart := LongPtr(ord4(RowStart) + RowOffset);
                    end;
                SelectSlice(StackInfo^.CurrentSlice);
            end; {with}
    end;


    function DoColorOptions: boolean;
        const
            ExistingID = 4;
            SystemID = 5;
            CustomID = 6;
            DitherID = 7;
        var
            mylog: DialogPtr;
            item: integer;

        procedure UpdateButtons;
        begin
            SetDlogItem(mylog, ExistingID, ord(RGBLut = ExistingLUT));
            SetDlogItem(mylog, SystemID, ord(RGBLut = SystemLUT));
            SetDlogItem(mylog, CustomID, ord(RGBLut = CustomLUT));
        end;

    begin
        InitCursor;
        mylog := GetNewDialog(160, nil, pointer(-1));
        SetDlogItem(mylog, DitherID, ord(DitherColor));
        UpdateButtons;
        OutlineButton(MyLog, ok, 16);
        repeat
            ModalDialog(nil, item);
            if item = DitherID then begin
                    DitherColor := not DitherColor;
                    SetDlogItem(mylog, DitherID, ord(DitherColor));
                end;
            if item = ExistingID then begin
                    RGBLut := ExistingLUT;
                    UpdateButtons
                end;
            if item = SystemID then begin
                    RGBLut := SystemLUT;
                    UpdateButtons;
                    DitherColor := true;
                    SetDlogItem(mylog, DitherID, ord(DitherColor));
                end;
            if item = CustomID then begin
                    RGBLut := CustomLUT;
                    UpdateButtons
                end;
        until (item = ok) or (item = cancel);
        DisposeDialog(mylog);
        DoColorOptions := item <> cancel;
    end;



    procedure ConvertRGBToEightBitColor (Capturing: boolean);
        var
            err: QDErr;
            err2: OSErr;
            osGWorld: GWorldPtr;
            flags: GWorldFlags;
            pmap: PixMapHandle;
            pRect: rect;
            thePictInfo: PictInfo;
            CopyMode, SamplingMethod: integer;
            UpdateNeeded: boolean;
            SaveGDevice: GDHandle;
    begin
        if not System7 then begin
                PutError('You must be running System 7 to do 24 to 8-bit color conversions.');
                exit(ConvertRGBToEightBitColor);
            end;
        with info^ do begin
                if StackInfo^.nSlices <> 3 then begin
                        PutError('24 to 8-bit color conversion requires a three slice (red, green and blue) stack as input.');
                        exit(ConvertRGBToEightBitColor);
                    end;
                if StackInfo^.StackType <> rgbStack then begin;
                    StackInfo^.StackType := rgbStack;
                    UpdateTitleBar;
                end;
                if Capturing then begin
                        DitherColor := true;
                        RGBLut := CustomLUT;
                    end
                else if not macro then begin
                        if not DoColorOptions then
                            exit(ConvertRGBToEightBitColor);
                    end;
                flags := 0; {ppc-bug}
                SaveGDevice := GetGDevice;
                SetGDevice(osGDevice);
                err := NewGWorld(osGWorld, 32, PicRect, nil, nil, flags);
                SetGDevice(SaveGDevice);
                if err <> NoErr then begin
                        PutMemoryAlert;
                        exit(ConvertRGBToEightBitColor);
                    end;
                pmap := GetGWorldPixMap(osGWorld);
                if not LockPixels(pmap) then
                    begin
                        DisposeGWorld(osGWorld);
                        exit(ConvertRGBToEightBitColor);
                    end;
                CopyRGBToPixMap(pmap);
                pRect := PicRect;
            end; {with}
        UpdateNeeded := true;
        if Activate('Indexed Color') then begin
                if (info^.PixelsPerLine <> pRect.right) or (info^.nLines <> pRect.bottom) then begin
                        if not NewPicWindow('Indexed Color', pRect.right, pRect.bottom) then
                            begin
                                DisposeGWorld(osGWorld);
                                exit(ConvertRGBToEightBitColor);
                            end;
                        UpdateNeeded := false;
                    end
            end
        else begin
                if not NewPicWindow('Indexed Color', pRect.right, pRect.bottom) then
                    begin
                        DisposeGWorld(osGWorld);
                        exit(ConvertRGBToEightBitColor);
                    end;
                UpdateNeeded := false;
            end;
        if RGBLut = SystemLUT then
            SwitchColorTables(SystemPaletteItem, false)
        else if RGBLut = CustomLut then begin
                if OptionKeyWasDown then
                    SamplingMethod := PopularMethod
                else
                    SamplingMethod := SystemMethod;
                err2 := GetPixMapInfo(pmap, thePictInfo, ReturnColorTable, 256, SamplingMethod, 0);
                LoadColorTable(thePictInfo.theColorTable);
            end;
        SetForegroundColor(BlackIndex);
        SetBackgroundColor(WhiteIndex);
        if DitherColor then
            CopyMode := DitherCopy
        else
            CopyMode := SrcCopy;
        SetGDevice(osGDevice);
        SetPort(GrafPtr(Info^.osPort));
        CopyBits(BitMapHandle(pmap)^^, BitMapHandle(info^.osPort^.PortPixMap)^^, pRect, pRect, CopyMode, nil);
        DisposeGWorld(osGWorld);
        SetGDevice(SaveGDevice);
        if UpdateNeeded then
            UpdatePicWindow;
    end;


    function MakeRGBStack (name: str255): boolean;
        var
            ignore: integer;
    begin
        MakeRGBStack := false;
        if not Duplicate(name, false) then
            exit(MakeRGBStack);
        if not MakeStackFromWindow then
            exit(MakeRGBStack);
        if not AddSlice(false) then begin
                info^.changes := false;
                ignore := CloseAWindow(info^.wptr);
                exit(MakeRGBStack);
            end;
        if not AddSlice(false) then begin
                info^.changes := false;
                ignore := CloseAWindow(info^.wptr);
                exit(MakeRGBStack);
            end;
        MakeRGBStack := true;
    end;


    procedure ConvertEightBitColorToRGB;
        var
            width, height, i, row: integer;
            srcLine, rLine, gLine, bLine: LineType;
            rLut, gLUT, bLUT: packed array[0..255] of byte;
            value: byte;
    begin
        if isGrayscaleLUT then begin
                PutError('8-bit color to RGB conversion requires a color image.');
                exit(ConvertEightBitColorToRGB);
            end;
        KillRoi;
        if not MakeRGBStack(concat(info^.title, ' (RGB)')) then
            exit(ConvertEightBitColorToRGB);
        LoadLUT(Info^.cTable);
        for i := 0 to 255 do
            with cScreenPort^.portPixMap^^.pmTable^^.ctTable[i].rgb do begin
                    rLUT[i] := BitNot(band(bsr(red, 8), 255));
                    gLUT[i] := BitNot(band(bsr(green, 8), 255));
                    bLUT[i] := BitNot(band(bsr(blue, 8), 255));
                end;
        width := info^.PixelsPerLine;
        height := info^.nLines;
        for row := 0 to height - 1 do begin
                SelectSlice(1);
                GetLine(0, row, width, srcLine);
                for i := 0 to width - 1 do begin
                        value := srcLine[i];
                        rLine[i] := rLUT[value];
                        gLine[i] := gLUT[value];
                        bLine[i] := bLUT[value];
                    end;
                PutLine(0, row, width, rLine);
                SelectSlice(2);
                PutLine(0, row, width, gLine);
                SelectSlice(3);
                PutLine(0, row, width, bLine);
            end;
        with Info^.StackInfo^ do begin
                CurrentSlice := 1;
                SelectSlice(CurrentSlice);
                StackType := rgbStack;
                UpdateTitleBar;
            end;
        ResetGrayMap;
    end;


    procedure CopyGWorldToStack;
    {Copies the color image stored in the 32-bit GWorld used by QuickTime
     video digitizers to a 3 slice (RGB) stack.}
        type
            LongPtr = ^LongInt;
        var
            row, i, width, WatchRate: integer;
            RedLine, GreenLine, BlueLine: LineType;
            Pixel, RowOffset: LongInt;
            pmapPtr: ptr;
            LPtr, RowStart: LongPtr;
    begin
        if fgPixMap^^.pixelSize <> 32 then begin
            PutError('RGB capture requires a 24-bit digitizer.');
            DigitizerMode := digitizeColor;
            exit(CopyGWorldToStack);
        end;
        if not MakeRGBStack(StringOf('RGB-', nPics:1)) then
            exit(CopyGWorldToStack);
        with info^ do begin
            pmapPtr := GetPixBaseAddr(fgPixMap);
            if pmapPtr = nil then
                exit(CopyGWorldToStack);
            LPtr := LongPtr(pmapPtr);
            RowStart := LPtr;
            RowOffset := band(fgPixMap^^.RowBytes, $3FFF);
            width := PicRect.right;
            WatchRate := 40000 div PixelsPerLine;
            for row := 0 to nLines - 1 do begin
                    if (row mod WatchRate) = 0 then
                        ShowAnimatedWatch;
                    LPtr := RowStart;
                    for i := 0 to PixelsPerLine - 1 do begin
                            pixel := BitNot(LPtr^);
                            blueLine[i] := band(pixel, 255);
                            pixel := bsr(pixel, 8);
                            greenLine[i] := band(pixel, 255);
                            pixel := bsr(pixel, 8);
                            redLine[i] := band(pixel, 255);
                            LPtr := LongPtr(ord4(LPtr) + 4);
                        end;
                    RowStart := LongPtr(ord4(RowStart) + RowOffset);
                    SelectSlice(1);
                    PutLine(0, row, width, RedLine);
                    SelectSlice(2);
                    PutLine(0, row, width, GreenLine);
                    SelectSlice(3);
                    PutLine(0, row, width, BlueLine);
                end;
            with Info^.StackInfo^ do begin
                    CurrentSlice := 1;
                    SelectSlice(CurrentSlice);
                    StackType := rgbStack;
                    UpdateTitleBar;
                end;
            ResetGrayMap;
        end; {with}
    end;


    procedure CaptureVDigColor;
        var
            err: OSErr;
            pRect: rect;
            thePictInfo: PictInfo;
            SaveGDevice: GDHandle;
    begin
        if DigitizerMode = digitizeGrayscale then begin
            PutError('To capture color, "8-bit Color" or "RGB Color" must be selected in Video Control.');
            exit(CaptureVDigColor);
        end;
        if not digitizing then begin
            if info^.PictureType <> FrameGrabberType then
                SelectCameraWindow;
            CaptureAndDisplayFrame;
        end;
        if fgPixMap = nil then
            exit(CaptureVDigColor);
        SaveGDevice := GetGDevice;
        err := GetPixMapInfo(fgPixMap, thePictInfo, ReturnColorTable, 256, SystemMethod, 0);
        if err = noErr then begin
            LoadColorTable(thePictInfo.theColorTable);
            SetForegroundColor(BlackIndex);
            SetBackgroundColor(WhiteIndex);
            SetGDevice(osGDevice);
            SetPort(GrafPtr(Info^.osPort));
            with info^ do
                CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, picRect, picRect, DitherCopy, nil);
            SetGDevice(SaveGDevice);
            UpdatePicWindow;
            DrawLUT;
        end;
        if DigitizerMode = digitizeRGB then
            CopyGWorldToStack;
    end;


    procedure CaptureColor;
        var
            MainDevice: GDHandle;
            SourcePixMap: PixMapHandle;
            frame, width, height, SaveChannel: integer;
            frect: rect;
    begin
        with info^ do
            if PictureType <> FrameGrabberType then begin
                    PutError('You must be capturing to capture color.');
                    AbortMacro;
                    exit(CaptureColor);
                end;
        StopDigitizing;
        if frameGrabber = QTvdig then begin
            CaptureVDigColor;
            exit(CaptureColor);
        end;
        with info^.PicRect do begin
                width := right - left;
                height := bottom - top;
            end;
        if Activate('RGB') then
            with info^.PicRect do begin
                    if ((right - left) <> width) or ((bottom - top) <> height) then
                        if not MakeRGBStack('RGB') then
                            exit(CaptureColor);
                end
        else if not MakeRGBStack('RGB') then
            exit(CaptureColor);
        ShowWatch;
        SourcePixMap := fgPixMap;
        ResetFrameGrabber;
        with frect do begin
                left := 0;
                top := 0;
                right := left + width;
                bottom := top + height;
            end;
        ShowTriggerMessage;
        SaveChannel := VideoChannel;
        with info^, info^.StackInfo^ do begin
                for frame := 1 to 3 do begin
                        if FrameGrabber = QuickCapture then begin
                                case frame of
                                    1:
                                        VideoChannel := 1; {Green}
                                    2:
                                        VideoChannel := 0;  {Red}
                                    3:
                                        VideoChannel := 2;  {Blue}
                                end;
                                ResetFrameGrabber;
                                repeat
                                until band(ControlReg^, $8) = 0; {mux channel not busy}
                            end
                        else begin
                                VideoChannel := frame - 1;
                                ResetFrameGrabber;
                            end;
                        if VideoControl <> nil then
                            ShowChannel;
                        CurrentSlice := frame;
                        SelectSlice(CurrentSlice);
                        GetFrame;
                        CopyOffscreen(SourcePixMap, osPort^.portPixMap, frect, PicRect);
                    end; {for}
                CurrentSlice := 1;
                SelectSlice(CurrentSlice);
                UpdateTitleBar;
            end; {with}
        VideoChannel := SaveChannel;
        if VideoControl <> nil then
            ShowChannel;
        ConvertRGBToEightBitColor(true);
    end;


    procedure AverageSlices;
        const
            MaxWidth = 2048;
        var
            slices, sRow, aRow, slice, i, SaveSlice: integer;
            width, height, hstart, vStart: integer;
            OldInfo, NewInfo: InfoPtr;
            aLine: LineType;
            mask: rect;
            sum: array[0..MaxWidth] of LongInt;
            AutoSelectAll: boolean;
            SlicesDiv2:LongInt;
    begin
        OldInfo := Info;
        with info^ do begin
                if StackInfo = nil then begin
                        PutError('Average Slices requires a stack.');
                        AbortMacro;
                        exit(AverageSlices);
                    end;
                AutoSelectAll := not Info^.RoiShowing;
                if AutoSelectAll then
                    SelectAll(true);
                with RoiRect do begin
                        hStart := left;
                        vStart := top;
                        width := right - left;
                        height := bottom - top;
                    end;
                if width > MaxWidth then begin
                        PutError(concat('NIH Image can''t average selections wider than ', Long2str(MaxWidth), ' pixels.'));
                        AbortMacro;
                        exit(AverageSlices);
                    end;
                with StackInfo^ do begin
                        slices := StackInfo^.nSlices;
                        SaveSlice := CurrentSlice;
                    end;
                if not NewPicWindow('Average', width, height) then begin
                        AbortMacro;
                        exit(AverageSlices);
                    end;
            end;
        info^.changes := true;
        NewInfo := Info;
        aRow := 0;
        SlicesDiv2:=slices div 2; {Needed for rounding}
        for sRow := vStart to vStart + height - 1 do begin
                info := OldInfo;
                for i := 0 to width - 1 do
                    sum[i] := 0;
                for slice := 1 to slices do begin
                        SelectSlice(slice);
                        GetLine(hStart, sRow, width, aLine);
                        for i := 0 to width - 1 do
                            sum[i] := sum[i] + aLine[i];
                    end;
                for i := 0 to width - 1 do
                    aLine[i] := (sum[i]+SlicesDiv2) div slices;
                info := NewInfo;
                PutLine(0, aRow, width, aLine);
                SetRect(mask, 0, aRow, width, aRow + 1);
                aRow := aRow + 1;
                UpdateScreen(mask);
                if CommandPeriod then
                    leave;
            end;
        info := OldInfo;
        SelectSlice(SaveSlice);
        if AutoSelectAll then
            KillRoi;
        info:=NewInfo;
    end;


    procedure ConvertRGBToHSV;
        const
            MaxSaturation = 255;
            MaxValue = 255;
        var
            width, height, i, row, mark: integer;
            rLine, gLine, bLine, hLine, sLine, vLine: LineType;
            delta, min, max, R, G, B, H, S, V: integer;
            tmp: longint;
            UpdateR: rect;

        function Max3 (a, b, c: integer): integer;
            var
                TempMax: integer;
        begin
            if (a > b) then
                TempMax := a
            else
                TempMax := b;
            if (TempMax > c) then
                Max3 := TempMax
            else
                Max3 := c;
        end;

        function Min3 (a, b, c: integer): integer;
            var
                TempMin: integer;
        begin
            if (a < b) then
                TempMin := a
            else
                TempMin := b;
            if (TempMin < c) then
                Min3 := TempMin
            else
                Min3 := c;
        end;

    begin
        with info^ do begin
                if StackInfo^.nSlices <> 3 then begin
                        PutError('RGB to HSV color conversion requires a three slice(red, green and blue) stack as input.');
                        exit(ConvertRGBToHSV);
                    end;
                if Changes then begin
                        if PutMessageWithCancel('RGB to HSV color conversion is undoable.') = cancel then
                            exit(ConvertRGBToHSV);
                    end;
                KillRoi;
                with StackInfo^ do begin
                        CurrentSlice := 1;
                        SelectSlice(CurrentSlice);
                        UpdatePicWindow;
                    end;
                SwitchColorTables(SpectrumItem, true);
                title := 'HSV';
                UpdateTitleBar;
                width := PixelsPerLine;
                height := nLines;
                mark := 0;
                ShowWatch;
                for row := 0 to height - 1 do begin
                        SelectSlice(1);
                        GetLine(0, row, width, rLine);
                        SelectSlice(2);
                        GetLine(0, row, width, gLine);
                        SelectSlice(3);
                        GetLine(0, row, width, bLine);
                        for i := 0 to width - 1 do begin
                                R := 255 - rLine[i];
                                G := 255 - gLine[i];
                                B := 255 - bLine[i];
                                max := Max3(R, G, B);
                                min := Min3(R, G, B);
                                V := max;
                                if max <> 0 then begin
                                        tmp := 255 * (max - min);
                                        S := (tmp + (tmp mod max)) div max;  {adding '(tmp mod max)' simulate rounding}
                                    end
                                else
                                    S := 0;
                                if S = 0 then
                                    H := 0  {undefined but, but select red }
                                else begin
                                        delta := max - min;
                                        if R = max then begin
                                                tmp := 85 * (G - B);
                                                H := tmp div delta;
                                            end
                                        else if G = max then begin
                                                tmp := 85 * (B - R);
                                                H := 170 + tmp div delta;
                                            end
                                        else if B = max then begin
                                                tmp := 85 * (R - G);
                                                H := 340 + tmp div delta;
                                            end;
                                        H := H div 2;
                                        if H < 0 then
                                            H := H + 255
                                    end;
                                if H = 0 then
                                    hLine[i] := 1
                                else
                                    hLine[i] := H;
                                sLine[i] := S;
                                vLine[i] := 255 - V;
                            end;
                        SelectSlice(1);
                        PutLine(0, row, width, hLine);
                        if (row mod 10) = 0 then begin
                                setrect(UpdateR, 0, mark, width - 1, row);
                                mark := row;
                                UpdateScreen(UpdateR);
                            end;
                        SelectSlice(2);
                        PutLine(0, row, width, sLine);
                        SelectSlice(3);
                        PutLine(0, row, width, vLine);
                    end;
                SelectSlice(1);
                StackInfo^.StackType := hsvStack;
                UpdateTitleBar;
            end; {with}
        WhatToUndo := NothingToUndo;
    end;


    procedure DoStackInfo;
    const
        VolumeID = 5;
        MovieID = 6;
        RGBID = 7;
        HSVID = 8;
        SpacingID = 11;
        IntervalID = 12;
    var
        mylog: DialogPtr;
        item: integer;
        spacing, SaveSpacing, SaveInterval: extended;
        SaveType: StackTypeType;
        str: str255;

        procedure ShowStackType;
        begin
            With info^.StackInfo^ do begin
                SetDlogItem(MyLog, VolumeID, ord(StackType = VolumeStack));
                SetDlogItem(MyLog, MovieID, ord(StackType = MovieStack));
                SetDlogItem(MyLog, RGBID, ord(StackType = rgbStack));
                SetDlogItem(MyLog, HSVID, ord(StackType = hsvStack));
            end;
        end;

    begin
        With info^, info^.StackInfo^ do begin
            InitCursor;
            mylog := GetNewDialog(280, nil, pointer(-1));
            SaveType := StackType;
            SaveSpacing := SliceSpacing;
            SaveInterval := Frameinterval;
            ShowStackType;
            if SpatiallyCalibrated then begin
                spacing := SliceSpacing / xScale;
                str := xunit;
            end else begin
                spacing := SliceSpacing;
                str := 'pixels'
            end;
            SetDReal(MyLog, SpacingID, spacing, 3);
            ParamText(str, '', '', '');
            if Frameinterval < 99.0 then
                SetDReal(MyLog, IntervalID, Frameinterval, 3)
            else
                SetDReal(MyLog, IntervalID, Frameinterval, 0);
            SelectDialogItemText(MyLog, SpacingID, 0, 32767);
            OutlineButton(MyLog, ok, 16);
            repeat
                ModalDialog(nil, item);
                if (item >= VolumeID) and (item <= HSVID) then begin
                    case item of
                        VolumeID: StackType := VolumeStack;
                        MovieID: StackType := MovieStack;
                        rgbID: StackType := rgbStack;
                        hsvID: StackType := hsvStack;
                    end;
                    ShowStackType;
                  end;
                if item = SpacingID then begin
                    spacing := GetDReal(MyLog, SpacingID);
                    if SpatiallyCalibrated then
                        SliceSpacing := spacing * xScale
                    else
                        SliceSpacing := spacing;
                end;
                if item = IntervalID then
                    Frameinterval := GetDReal(MyLog, IntervalID);
            until (item = ok) or (item = cancel);
            DisposeDialog(mylog);
            if item = cancel then begin
                StackType := SaveType;
                SliceSpacing := SaveSpacing;
                Frameinterval := SaveInterval;
            end else
                if ((StackType = rgbStack) or (StackType = hsvStack)) and (nSlices <> 3) then begin
                    PutError('RGB and HSV stacks must have three slices.');
                    StackType := SaveType;
                end;
        end; {with}
        UpdateTitleBar;
    end;


end.